home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectPlay / SimplePeer / frmApp.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  9.4 KB  |  236 lines
  1. VERSION 5.00
  2. Begin VB.Form frmApp 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Session"
  5.    ClientHeight    =   4470
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5400
  9.    Icon            =   "frmApp.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4470
  14.    ScaleWidth      =   5400
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.CommandButton cmdExit 
  17.       Cancel          =   -1  'True
  18.       Caption         =   "Exit"
  19.       Height          =   315
  20.       Left            =   3383
  21.       TabIndex        =   9
  22.       Top             =   4020
  23.       Width           =   1035
  24.    End
  25.    Begin VB.Frame Rules 
  26.       Caption         =   "Rules"
  27.       Height          =   735
  28.       Left            =   60
  29.       TabIndex        =   5
  30.       Top             =   60
  31.       Width           =   5295
  32.       Begin VB.Label Label1 
  33.          BackStyle       =   0  'Transparent
  34.          Caption         =   $"frmApp.frx":0442
  35.          Height          =   435
  36.          Index           =   1
  37.          Left            =   60
  38.          TabIndex        =   6
  39.          Top             =   180
  40.          Width           =   5175
  41.       End
  42.    End
  43.    Begin VB.TextBox txtFace 
  44.       BackColor       =   &H8000000F&
  45.       Height          =   2295
  46.       Left            =   120
  47.       Locked          =   -1  'True
  48.       MultiLine       =   -1  'True
  49.       ScrollBars      =   2  'Vertical
  50.       TabIndex        =   4
  51.       Top             =   1620
  52.       Width           =   5235
  53.    End
  54.    Begin VB.CommandButton cmdMakeFace 
  55.       Caption         =   "Make Face"
  56.       Default         =   -1  'True
  57.       Height          =   315
  58.       Left            =   983
  59.       TabIndex        =   1
  60.       Top             =   4020
  61.       Width           =   1035
  62.    End
  63.    Begin VB.Frame Frame1 
  64.       Caption         =   "Game Status"
  65.       Height          =   735
  66.       Left            =   60
  67.       TabIndex        =   0
  68.       Top             =   840
  69.       Width           =   5295
  70.       Begin VB.Label lblPlayerName 
  71.          BackStyle       =   0  'Transparent
  72.          Height          =   255
  73.          Left            =   1980
  74.          TabIndex        =   8
  75.          Top             =   180
  76.          Width           =   3135
  77.       End
  78.       Begin VB.Label Label1 
  79.          BackStyle       =   0  'Transparent
  80.          Caption         =   "Local Player Name:"
  81.          Height          =   195
  82.          Index           =   2
  83.          Left            =   120
  84.          TabIndex        =   7
  85.          Top             =   180
  86.          Width           =   1935
  87.       End
  88.       Begin VB.Label lblPlayer 
  89.          BackStyle       =   0  'Transparent
  90.          Height          =   255
  91.          Left            =   2040
  92.          TabIndex        =   3
  93.          Top             =   420
  94.          Width           =   3075
  95.       End
  96.       Begin VB.Label Label1 
  97.          BackStyle       =   0  'Transparent
  98.          Caption         =   "Current number of players:"
  99.          Height          =   195
  100.          Index           =   0
  101.          Left            =   120
  102.          TabIndex        =   2
  103.          Top             =   420
  104.          Width           =   1935
  105.       End
  106.    End
  107. Attribute VB_Name = "frmApp"
  108. Attribute VB_GlobalNameSpace = False
  109. Attribute VB_Creatable = False
  110. Attribute VB_PredeclaredId = True
  111. Attribute VB_Exposed = False
  112. Option Explicit
  113. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  114. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  115. '  File:       frmApp.frm
  116. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  117. Implements DirectPlay8Event
  118. Private Const gbMSGFACE As Byte = 1
  119. Private msName As String
  120. Private Sub cmdExit_Click()
  121.     Unload Me
  122. End Sub
  123. Private Sub cmdMakeFace_Click()
  124.     Dim Buf() As Byte, lOffSet As Long
  125.     'For the purpose of this sample we don't care what the contents of the buffer
  126.     'will be.  Since there is only one application defined msg in this sample
  127.     'sending anything will suffice.
  128.     If glNumPlayers > 1 Then 'Go ahead and send this to someone
  129.         lOffSet = NewBuffer(Buf)
  130.         AddDataToBuffer Buf, gbMSGFACE, SIZE_BYTE, lOffSet
  131.         dpp.SendTo DPNID_ALL_PLAYERS_GROUP, Buf, 0, DPNSEND_NOLOOPBACK
  132.     Else
  133.         UpdateText "There is no one to make faces at!!!"
  134.     End If
  135. End Sub
  136. Private Sub Form_Load()
  137.     'Init our vars
  138.     InitDPlay
  139.     Set DPlayEventsForm = New DPlayConnect
  140.     'First lets get the dplay connection started
  141.     If Not DPlayEventsForm.StartConnectWizard(dx, dpp, AppGuid, 10, Me) Then
  142.         Cleanup
  143.         End
  144.     End If
  145.     gfHost = DPlayEventsForm.IsHost
  146.     msName = DPlayEventsForm.UserName
  147.     lblPlayerName.Caption = msName
  148.     If gfHost Then
  149.         Me.Caption = DPlayEventsForm.SessionName & " (HOST)"
  150.     End If
  151.     lblPlayer.Caption = CStr(glNumPlayers)
  152. End Sub
  153. Private Sub Form_Unload(Cancel As Integer)
  154.     Cleanup
  155. End Sub
  156. Private Sub UpdateText(ByVal sString As String)
  157.     'Update the chat window first
  158.     txtFace.Text = txtFace.Text & sString & vbCrLf
  159.     'Now limit the text in the window to be 16k
  160.     If Len(txtFace.Text) > 16384 Then
  161.         txtFace.Text = Right$(txtFace.Text, 16384)
  162.     End If
  163.     'Autoscroll the text
  164.     txtFace.SelStart = Len(txtFace.Text)
  165. End Sub
  166. Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
  167.     'VB requires that we must implement *every* member of this interface
  168. End Sub
  169. Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
  170.     'VB requires that we must implement *every* member of this interface
  171. End Sub
  172. Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
  173.     'VB requires that we must implement *every* member of this interface
  174. End Sub
  175. Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
  176.     Dim AppDesc As DPN_APPLICATION_DESC
  177.     'Go ahead and put the session name in the title bar
  178.     AppDesc = dpp.GetApplicationDesc
  179.     Me.Caption = AppDesc.SessionName
  180. End Sub
  181. Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
  182.     'VB requires that we must implement *every* member of this interface
  183. End Sub
  184. Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
  185.     'Someone joined, increment the count
  186.     glNumPlayers = glNumPlayers + 1
  187.     lblPlayer.Caption = CStr(glNumPlayers)
  188. End Sub
  189. Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  190.     'VB requires that we must implement *every* member of this interface
  191. End Sub
  192. Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  193.     'Someone left, decrement the count
  194.     glNumPlayers = glNumPlayers - 1
  195.     lblPlayer.Caption = CStr(glNumPlayers)
  196. End Sub
  197. Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
  198.     'VB requires that we must implement *every* member of this interface
  199. End Sub
  200. Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
  201.     'VB requires that we must implement *every* member of this interface
  202. End Sub
  203. Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
  204.     Dim dpPeer As DPN_PLAYER_INFO
  205.     dpPeer = dpp.GetPeerInfo(lNewHostID)
  206.     If (dpPeer.lPlayerFlags And DPNPLAYER_LOCAL) = DPNPLAYER_LOCAL Then 'I am the new host
  207.         Me.Caption = Me.Caption & " (HOST)"
  208.     End If
  209. End Sub
  210. Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
  211.     'VB requires that we must implement *every* member of this interface
  212. End Sub
  213. Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
  214.     'VB requires that we must implement *every* member of this interface
  215. End Sub
  216. Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
  217.     'VB requires that we must implement *every* member of this interface
  218. End Sub
  219. Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
  220.     'There is only one msg that can be sent in this sample
  221.     Dim sPeer As String
  222.     sPeer = dpp.GetPeerInfo(dpnotify.idSender).Name
  223.     UpdateText sPeer & " is making funny faces at you, " & msName
  224. End Sub
  225. Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
  226.     'VB requires that we must implement *every* member of this interface
  227. End Sub
  228. Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
  229.     If dpnotify.hResultCode = DPNERR_HOSTTERMINATEDSESSION Then
  230.         MsgBox "The host has terminated this session.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
  231.     Else
  232.         MsgBox "This session has been lost.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
  233.     End If
  234.     DPlayEventsForm.CloseForm Me
  235. End Sub
  236.